; ORIGINAL: 3dt2.1/examples/camera.scm
; $Id: camera.scm,v 1.4 1996/10/21 15:58:55 aed Exp $

;======================================================================
; Purpose---
;    Define scheme procedures which allow use of a camera model for setting
;    view parameters
;======================================================================

(provide 'camera)

;;----------------------------------------------------------------------
;; When you operate on the camera, the changes that you see in the view
;; are opposite the motions of the mouse.  For example, if you move the
;; camera to the left, the image in the view moves to the right.  This
;; variable lets you reverse the action so that it feels like you are
;; manipulating the object rather than manipulating the camera.
(define reverse-action #t)

;;----------------------------------------------------------------------
;; This procedure is for convienience in the remaining procedures.  It
;; gets the optional view argument for the remaining camera procedures.
;; If no view is given, then this procedure returns the current active
;; view.  Otherwise, it returns the given view.

(define (camera:get-view-arg view-arg)
  (cond
    ((null? view-arg) (env:active-view))
    ((view? (car view-arg)) (car view-arg))
    (else (camera:get-view-arg (cdr view-arg)))
    ))

;; Set the distance from the eye to the target
(define (view:set-distance distance . v)
  (let ((view (if (not (null? v)) (car v) (env:active-view))))
    (let ((eye (view:eye view))
          (target (view:target view))
          )
      (view:set-eye (position:offset target (gvector:scale (gvector:unitize (gvector:from-to target eye)) distance)))
      )))

;; Get the distance from the eye to the target
(define (view:distance  . v)
  (let ((view (if (not (null? v)) (car v) (env:active-view))))
    (position:distance (view:eye view) (view:target view))
    ))

;======================================================================
;; These procedures get the cameras current position and orientation as
;; well as its orientation.

;; Get the position of the camera
(define camera:position view:eye)

;; Get the position that the camera is aimed at.  This is the center of
;; rotation for camera:orbit
(define camera:target view:target)

;; Get the gvector in the direction in which the camera is pointing
;; Returns a unitized vector
(define (camera:direction . v)
  (gvector:reverse(apply view:out v)))

;; Get the gvector which points towards the top of the camera image.
;; Returns a unitized vector
(define camera:up view:up)

;; Get the gvector which points to the right of the camera image
;; Returns a unitized vector
(define camera:right view:right)

;======================================================================
;; These procedures are used to set the camera position or orientation
;; to absolute values.  Unlike the view: procedures, these procedures
;; will automatically refresh the view with the updated parameters.

;; Set the position of the camera.  The direction in which the camera
;; is pointed, and its field of view are left unchanged.
(define (camera:set-position pos . v)
  (let ((view (if (null? v) (env:active-view) (car v))))
    (view:set pos
              (position:offset pos (gvector:from-to (view:eye view)
                                                    (view:target view)))
              (view:up view)
              view)
    (view:refresh view)
    ))

;; Set the target of the camera.  The camera position will be changed
;; so that the viewing direction and orientation are not changed.
;; The target may be specified as either a position, an entity,
;; a list of entities, or the symbol 'auto.  If a position is given,
;; then that will be the new target.  If an entity or list of entities
;; is given, the the center of thier bounding box will be the new target.
;; If the symbol 'auto is given, then the center of the bounding box
;; of all entities in the part will be used.
(define (camera:set-target target . v)
  (let ((view (if (null? v) (env:active-view) (car v))))
    (let ((pos (cond
                 ((position? target) target)
                 (else
                   (let ((ents (if (eq? target 'auto)
                                   (part:entities (view:part view))
                                   target)))
                     (let ((box (entity:box ents)))
                       (position:interpolate (car box) (cdr box) .5)
                       ))))))
      (view:set
        (position:offset pos (gvector:from-to
                               (view:target view) (view:eye view)))
        pos
        (view:up view)
        view
        )
      (view:refresh view)
      )))

;======================================================================
;; The following procedures move the camera or change its orientation
;; given deltas from its current position or orientation.

;; Move the camera while preserving its orientation
(define (camera:move offset . v)
  (let ((view (if (null? v) (env:active-view) (car v))))
    (view:set (position:offset (view:eye view) offset)
              (position:offset (view:target view) offset)
              (view:up view)
              view
              )
    (view:refresh view)
    ))

;; Orbit the camera about its target.  The target will remain unchanged.
;; the camera's position and the direction in which is is aimed so as
;; to move about the target at a constant distance while still staying
;; aimed at the same target.
(define (camera:orbit vec angle . v)
  (let ((view (if (null? v) (env:active-view) (car v))))
    (let* ((target (view:target view))
           (tform (transform:rotation target vec angle))
           )
      (view:set
        (position:transform (view:eye view) tform)
        target
        (gvector:transform (view:up view) tform)
        view
        )
      (view:refresh view)
      )))

;; Rotate the camera.  The camera's position is kept fixed while it is
;; rotated about an axis thus changing the direction in which it is
;; aimed and the target
(define (camera:rotate vec angle . v)
  (let ((view (if (null? v) (env:active-view) (car v))))
    (let* ((eye (view:eye view))
           (tform (transform:rotation eye vec angle))
           )
      (view:set
        eye
        (position:transform (view:target view) tform)
        (gvector:transform (view:up view) tform)
        view
        )
      (view:refresh view)
      )))

;======================================================================
;; These procedures are used to control the field of view of the camera

;; Get the distance from the camera to the target
(define (camera:distance . v)
  (let ((view (if (null? v) (env:active-view) (car v))))
    (position:distance (view:eye view) (view:target view))
    ))

;; Set the distance from the camera to the target.  The distance is
;; changed by moving the camera position.
;; For a perspective view, this will change the field a view since
;; it is equivalent to moving the camera closer to or farthur away
;; from the target.
(define (camera:set-distance dist . v)
  (let ((view (if (null? v) (env:active-view) (car v))))
    (let ((eye (view:eye view))
          (target (view:target view))
          )
      (view:set-eye (position:offset
                      target
                      (gvector:scale
                        (gvector:unitize (gvector:from-to target eye))
                        dist))
                    view
                    )
      (view:refresh view)
      )))

;; Get the focal length of the camera
(define (camera:focal-length . v)
  (let ((view (if (null? v) (env:active-view) (car v))))
    (/ (* 35 (view:distance view)) (* 2 (view:width view)))
    ))

;; Set the focal length of the camera.  This procedure will not make the
;; iamge bigger or smaller.  It changes the distance from the camera to
;; the target, so that the image size remains approximately constatnt.
;; Use camera:zoom to change the focal length and also change the size of
;; the image.  Use camera:set-distance to change the size of the image
;; without changing the focal length.
(define (camera:set-focal-length fl . v)
  (let ((view (if (null? v) (env:active-view) (car v))))
    (let ((eye (view:eye view))
          (target (view:target view))
          (width (view:width))
          )
      (view:set-distance (/ (* 2 width fl) 35) view)
      (view:refresh view)
      )))

;; Zoom in or out with the camera.  This will change the focal length
;; and make the image smaller or larger.  The camera position and
;; target are not changed.
(define (camera:zoom zoom-scale . v)
  (let ((view (if (null? v) (env:active-view) (car v)))
        (scale (max .001 zoom-scale))
        )
    (view:set-size (/ (view:width view) scale)
                   (/ (view:height view) scale)
                   view)
    (view:refresh view)
    ))

;======================================================================
;;----------------------------------------------------------------------
;; Given proposed direction from the eye to the target and up direction,
;; compute a valid up direction.

(define camera:get-valid-up
  (lambda (dir view)
    (let ((up (view:up view)))
      (if (gvector:parallel? dir up)
          (if (gvector:parallel? dir (gvector 0 1 0))
              (gvector 0 0 1)
              (gvector 0 1 0))
          up
          ))))

;;----------------------------------------------------------------------
;; Set the direction in which the camera is pointed.
;; The camera position is changed, and the target is left unchanged.

(define (camera:set-direction dir . v)
  (let ((view (if (null? v) (env:active-view) (car v))))
    (let* ((target (view:target view))
           (distance (position:distance (view:eye view) target))
           (vec (gvector:scale (gvector:unitize dir) (- distance)))
           )
      (view:set (position:offset target vec)
                target
                (camera:get-valid-up dir view)
                view
                )
      (view:refresh view)
      )))

;;----------------------------------------------------------------------
;; Set the position and direction of the camera.

(define (camera:aim pos dir . v)
  (let ((view (if (null? v) (env:active-view) (car v))))
    (view:refresh view)
    ))

;;----------------------------------------------------------------------
;; Adjust the direction in which the camera is pointed so that the camera
;; will be parallel to the XY plane
(define (camera:horizontal . v)
  (let ((view (if (null? v) (env:active-view) (car v))))
    ;; Get the distance from the camera to the target
    (let ((distance (view:distance view))
          (eye (view:eye view))
          (target (view:target view))
          )
      ;; Adjust the Z value of the target so that it is in the same plane
      ;; parallel to the XY plane as the eye position
      (position:set-z! target (position:z eye))
      ;; Now set the camera parameters
      (view:set eye target (gvector 0 0 1) view)
      ;; Restore the old distance (focal length)
      (view:set-distance distance view)
      ;; Refresh the view)
      (view:refresh view)
      )))

;;======================================================================
;; The procedure camera:mouse lets you control the camera using the mouse.
;; There are a number of different modes which are selected by various
;; combinations of the mouse buttons and the shift and control keys.
;; For all modes, pushing a mouse button (with the appropriate modifiers)
;; initiates the mode.  You can then control the camera by moving the mouse
;; while holding down the mouse button.  When you let up the mouse button,
;; you stop moving the camera.

;; left button - walk mode
;;    This mode is like the interface to Doom.  Moving the mouse forward or
;;    back moves you in or out of the scene.  I.e. you are getting closer
;;    to or farther away from the object.  Moving the mouse right or left
;;    turns the camera right or left.  This mode changes the camera target.

;; shift left - pan mode
;;    In this mode, you are moving the camera up or down and left or right
;;    in the plane of the screen.  It is equivalent to keeping the camera
;;    pointed in the same direction while moving it left or right or up or
;;    down.

;; control left - zoom mode
;;    In this mode, you are maintaining the same distance from the model,
;;    but changing the zoom scale.  It is equivalent to zooming in or out
;;    with a zoom lense to make the image bigger or smaler.  Moving the
;;    mouse forward zooms in, moving the mouse back zooms out.  Right and
;;    left mouse motion is ignored.

;; right button - orbit mode
;;    In this mode, you maintain the same distance from the object and keep
;;    the camera pointed at the same position while moving around the object.
;;    This mode is most effective when the camera target is the center of
;;    object that you are looking at.  Because walk mode changes the target,
;;    if you have been walking aroung the model, even though it appears to
;;    be centered on the screen, the target might actually be quite a
;;    distance in front of or behind the model that you are looking at.
;;    This can cause orbit mode to appear to behave stragely.  To set the
;;    camera target to the center of an object, you can use the command
;;    (camera:set-target object), or (camera:set-target 'auto) to center the
;;    entire model.

;; shift right - turn mode
;;    In this mode, the position of the camera is kept fixed while it is
;;    turned left, right, up or down.  Moving the mouse left or right
;;    turns the camera left or right.  Moving the mouse away from you or
;;    towards you tilts the camera down or up.  This mode changes the
;;    camera target.

;; control right - roll mode
;;    In this mode, you are keeping the position and direction of the camera
;;    fixed and rotating it about the axis along which it is aimed.  Moving
;;    the mouse away from you rotates counter clockwise, pulling the mouse
;;    towards you rotates clockwise.  Left and right motion of the mouse is
;;    ignored.

(define camera:mouse
  (let ((last-pe '())
        (view '())
        (vpwidth '())
        (vpheight '())
        (vpsize '())
        (rb-procs (make-vector 7 '()))
        (dynsil #t)
        )
    (let ((walk (lambda (self pe)
                  (let ((dx (- (event:x last-pe) (event:x pe)))
                        (dy (- (event:y last-pe) (event:y pe)))
                        )
                    ;; Determine if we are walking or turning
                    (if (> (abs dx) (abs dy))
                        ;; turn
                        (let ((angle (/ (* dx 45) vpsize)))
                          (camera:rotate (camera:up view) angle view)
                          )
                        ;; walk (get closer to object)
                        (let ((dist (* 4 dy (/ (view:height view) vpheight))))
                          (camera:move
                            (gvector:scale (camera:direction view) dist) view)
                          )
                        ))
                  (set! last-pe pe)
                  ))
          (pan (lambda (self pe)
                 (let ((dx (* (- (event:x pe) (event:x last-pe))
                              (/ (view:width view) vpwidth)))
                       (dy (* (- (event:y last-pe) (event:y pe))
                              (/ (view:height view) vpheight)))
                       )
                   (let ((offset (gvector:+ (gvector:scale (camera:right view) dx)
                                            (gvector:scale (camera:up view) dy)
                                            )))
                     (camera:move
                       (if reverse-action (gvector:reverse offset) offset)
                       view
                       ))
                   (set! last-pe pe)
                   )))
          (zoom (lambda (self pe)
                  (let* ((dy (- (event:y last-pe) (event:y pe)))
                         (scale (if (> 0 dy)
                                    (+ 1 (/ dy vpheight))
                                    (/ 1 (+ 1 (/ (- dy) vpheight)))
                                    ))
                         )
                    (camera:zoom scale view)
                    )
                  (set! last-pe pe)
                  ))
          (orbit (lambda (self pe)
                   (let ((dx (- (event:x pe) (event:x last-pe)))
                         ; The origin for pick-events is the upper left corner
                         ; rather than the lower left corner, so we have to reverse
                         ; the y values when computing the direction moved.
                         (dy (- (event:y last-pe) (event:y pe)))
                         )
                     (let ((axis (gvector:+ (gvector:scale (camera:right view) (- dy))
                                            (gvector:scale (camera:up view) dx)))
                           (ang (/ (* (sqrt (+ (* dx dx) (* dy dy))) 360) vpsize))
                           )
                       (camera:orbit axis (if reverse-action (- ang) ang) view)
                       ))
                   (set! last-pe pe)
                   ))
          (turn (lambda (self pe)
                  (let ((dx (- (event:x pe) (event:x last-pe)))
                        (dy (- (event:y last-pe) (event:y pe)))
                        )
                    (let ((axis (gvector:+ (gvector:scale (camera:right view) dy)
                                           (gvector:scale (camera:up view) (- dx))))
                          (ang (/ (* (sqrt (+ (* dx dx) (* dy dy))) 45) vpsize))
                          )
                      (camera:rotate axis (if reverse-action (- ang) ang) view)
                      ))
                  (set! last-pe pe)
                  ))
          (roll (lambda (self pe)
                  (let* ((dy (- (event:y last-pe) (event:y pe)))
                         (ang (/ (* dy 360) vpheight))
                         )
                    (camera:rotate
                      (camera:direction view)
                      (if reverse-action (- ang) ang)
                      view)
                    )
                  (set! last-pe pe)
                  ))
          (rbd (rbd:scheme #f rb-procs))
          )
      (lambda ()
        (set! mouse-down-hook
              (lambda (pe)
                (set! view (event:view pe))
                (set! last-pe pe)
                (let ((viewport (view:viewport view)))
                  (set! vpwidth (- (cadddr viewport) (car viewport)))
                  (set! vpheight (- (caddr viewport) (cadr viewport)))
                  )
                (set! vpsize (max vpwidth vpheight))
                (set! dynsil (dl:dynamic-silhouette-display #f))
                (rbd:clear)
                ;; Determine which action to perform
                (vector-set!
                  rb-procs 2
                  (cond
                    ((event:left? pe)
                     (cond
                       ((event:shift? pe) pan)
                       ((event:control? pe) zoom)
                       (else walk)
                       ))
                    ((event:right? pe)
                     (cond
                       ((event:shift? pe) turn)
                       ((event:control? pe) roll)
                       (else orbit)
                       ))
                    ))
                (rbd:add rbd)
                ))
        (set! mouse-up-hook
              (lambda (pe)
                (rbd:remove rbd)
                (dl:dynamic-silhouette-display dynsil)
                (view:refresh view)
                ))
        ))))
